COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "FOURSOME"
C00003 00003	SAVEI DOI REDOI SAVEK DOK REDOK SAVEM DOM REDOM SAVEN DON REDON DOERR REDOERR DOX REDOX EVAL
C00010 00004	$ Main program starts here
C00017 ENDMK
C⊗;
BEGIN "FOURSOME";
DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
DEFINE BOARDS="6",PLAYERS="16";
INTEGER ARRAY SET,SET1[0:16,0:6];	$ Trial and best array;
INTEGER ARRAY HIT,HIT1[0:16,0:16];	$ Hits;
INTEGER ARRAY NONO,NONO1[0:16,0:16];	$ Pardners;
INTEGER ARRAY ISAVE,KSAVE,MSAVE,NSAVE,HSAVE[0:25];
INTEGER ARRAY PSAVE,QSAVE[0:96];
PRELOAD_WITH 0,1,2,3,4,1,3,2,4,2,1,3,4,4,1,3,2,3,2,1,4,2,3,4,1,0;
INTEGER ARRAY TAB[0:97];
INTEGER B,H,I,J,K,L,M,N,P,Q,R,T,U,V,W,X,Y;
INTEGER CHAN,HITMAX,HITNUM,HITMA2,HITNU2,HITSUM,HITSUM2,HFINAL;
STRING TALLY,SUMMARY;
COMMENT SAVEI DOI REDOI SAVEK DOK REDOK SAVEM DOM REDOM SAVEN DON REDON DOERR REDOERR DOX REDOX EVAL;

PROCEDURE SAVEI;
⊂ SET[I,J]←(T LSH 27); ISAVE[B]←PSAVE[X]←I;
  OUTSTR(CVS(I)&",");
  SUMMARY←SUMMARY&CVS(I)&",";
⊃;

PROCEDURE DOI;
⊂ FOR I←1 STEP 1 UNTIL 16  DO IF SET[I,J]=0 THEN DONE;
  PSAVE[X]←I;
  IF I≤16 THEN  SAVEI;
⊃;

PROCEDURE REDOI;
⊂
 I←ISAVE[B]; K←KSAVE[B];
 OUTSTR('15&'12&"("&CVS(B)&")-I"&CVS(I)&",");
 FOR I←PSAVE[X]+1 STEP 1 UNTIL 16 DO IF SET[I,J]=0 THEN DONE;
 PSAVE[X]←I;
 IF I≤16 THEN SAVEI ELSE SET[ISAVE[B],J]←0;
⊃;

PROCEDURE SAVEK;
⊂ KSAVE[B]←PSAVE[X]←K; QSAVE[X]←L;
  SET[K,J]←(T LSH 27)+(I LSH 18); NONO[I,K]←NONO[K,I]←1;
  SET[I,J]←SET[I,J]+(K LSH 18);
  HIT[I,K]←HIT[I,K]+1;
  HIT[K,I]←HIT[K,I]+1;
  OUTSTR(CVS(K)&",");
  SUMMARY←SUMMARY&CVS(K)&",";
⊃;


PROCEDURE DOK;
⊂ FOR L←0 STEP 1 UNTIL 6 DO
  ⊂ "LL"
    FOR K←1 STEP 1 UNTIL 16 DO
    IF (SET[K,J]=0)∧(NONO[I,K]=0)∧(HIT[I,K]≤L)  THEN DONE "LL";
  ⊃ "LL";
  PSAVE[X]←K; QSAVE[X]←L;
  IF K≤16 THEN SAVEK;
⊃;

PROCEDURE REDOK;
⊂ K←KSAVE[B]; M←MSAVE[B]; N←NSAVE[B];
  NONO[I,K]←NONO[K,I]←0;
  SET[I,J]←SET[I,J]-(K LSH 18);
  HIT[I,K]←HIT[I,K]-1;
  HIT[K,I]←HIT[K,I]-1;
  OUTSTR("-K"&CVS(K)&",");
  FOR K←PSAVE[X]+1 STEP 1 UNTIL 16 DO
    IF (SET[K,J]=0)∧(NONO[I,K]=0)∧(HIT[I,K]≤QSAVE[X]) THEN DONE;
  PSAVE[X]←K;
  IF K≤16 THEN SAVEK ELSE SET[KSAVE[B],J]←0;
⊃;

PROCEDURE SAVEM;
⊂  SET[M,J]←(T LSH 27)+(I LSH 9)+K;
  SET[I,J]←SET[I,J]+(M LSH 9); SET[K,J]←SET[K,J]+(M LSH 9);
  HIT[M,I]←HIT[M,I]+1; HIT[M,K]←HIT[M,K]+1;
  HIT[I,M]←HIT[I,M]+1; HIT[K,M]←HIT[K,M]+1;
  MSAVE[B]←PSAVE[X]←M; QSAVE[X]←Q;
  OUTSTR(CVS(M)&",");
  SUMMARY←SUMMARY&CVS(M)&",";
⊃;

PROCEDURE DOM;
⊂ FOR Q←0 STEP 1 UNTIL 6 DO
  ⊂ "QQ"
    FOR M←1 STEP 1 UNTIL 16 DO
     IF (SET[M,J]=0)∧((HIT[I,M]+HIT[K,M])≤Q) THEN DONE "QQ";
  ⊃ "QQ";
  PSAVE[X]←M; QSAVE[X]←Q;
  IF M≤16 THEN SAVEM;
⊃;
  
PROCEDURE REDOM;
⊂ M←MSAVE[B]; Q←QSAVE[X]; N←NSAVE[B];
  OUTSTR("-M"&CVS(M)&",");
  SET[I,J]←SET[I,J]-(M LSH 9);  SET[K,J]←SET[K,J]-(M LSH 9);
  HIT[I,M]←HIT[I,M]-1; HIT[K,M]←HIT[K,M]-1;
  HIT[M,I]←HIT[M,I]-1; HIT[M,K]←HIT[M,K]-1;
  FOR M←PSAVE[X]+1 STEP 1 UNTIL 16 DO
    IF (SET[M,J]=0)∧((HIT[I,M]+HIT[K,M])≤QSAVE[X]) THEN DONE;
  PSAVE[X]←M;
  IF M≤16 THEN SAVEM ELSE SET[MSAVE[B],J]←0;
⊃;

PROCEDURE SAVEN;
⊂ SET[N,J]←(T LSH 27)+(M LSH 18)+(I LSH 9)+K;
  SET[M,J]←SET[M,J]+N LSH 18;
  SET[K,J]←SET[K,J]+N;  SET[I,J]←SET[I,J]+N;
  NSAVE[B]←PSAVE[X]←N; QSAVE[X]←R;
  HIT[I,N]←HIT[N,I]←HIT[I,N]+1;  HIT[K,N]←HIT[N,K]←HIT[N,K]+1;
  HIT[M,N]←HIT[N,M]←HIT[N,M]+1;
  NONO[M,N]←NONO[N,M]←1;
  OUTSTR(CVS(N)&" 	");
  SUMMARY←SUMMARY&CVS(N)&" 	";
⊃;

PROCEDURE DON;
⊂   FOR R←0 STEP 1 UNTIL 6 DO
  ⊂ "RR"
     FOR N←1 STEP 1 UNTIL 16 DO
 IF (SET[N,J]=0)∧(NONO[M,N]=0)∧((HIT[I,N]+HIT[K,N]+HIT[M,N])≤R) THEN DONE "RR";
  ⊃ "RR";
  PSAVE[X]←N;
  IF N≤16 THEN SAVEN;
⊃;

PROCEDURE REDON;
⊂ N←NSAVE[B]; R←QSAVE[X]; I←ISAVE[B]; K←KSAVE[B]; M←MSAVE[B];
  OUTSTR("-N"&CVS(N)&",");
  SET[I,J]←SET[I,J]-N; SET[K,J]←SET[K,J]-N;
  SET[M,J]←SET[M,J]-N;
  HIT[N,I]←HIT[I,N]←HIT[I,N]-1; HIT[N,K]←HIT[K,N]←HIT[K,N]-1;
  NONO[M,N]←NONO[N,M]←0;
  FOR N←PSAVE[X]+1 STEP 1 UNTIL 16 DO
   IF (SET[N,J]=0)∧(NONO[M,N]=0)∧((HIT[I,N]+HIT[K,N]+HIT[M,N])≤R) THEN DONE;
  PSAVE[X]←N;
  IF N≤16 THEN SAVEN ELSE SET[NSAVE[B],J]←0;
⊃;

PROCEDURE DOERR;
⊂ OUTSTR("DOERR "); ⊃;

PROCEDURE REDOERR;
⊂ OUTSTR("REDOERR "); ⊃;


PROCEDURE DOX;
⊂ Y←(X MOD 4); IF Y=0 THEN Y←4;
   CASE Y OF ⊂ DOERR; DOI; DOK; DOM; DON; ⊃;
⊃;
PROCEDURE REDOX;
⊂ Y←(X MOD 4);  IF Y=0 THEN Y←4;
  CASE Y OF ⊂ REDOERR;  REDOI; REDOK; REDOM; REDON; ⊃;
⊃;

PROCEDURE EVAL;
⊂ OUTSTR("EVAL ");
  H←0;
  FOR V←1 STEP 1 UNTIL 16 DO
    FOR W←1 STEP 1 UNTIL 16 DO IF HIT[V,W]>1 THEN  H←H+HIT[V,W]-1;
  IF H<HFINAL THEN 
  ⊂ ARRTRAN(SET1,SET); ARRTRAN(HIT1,HIT);
    ARRTRAN(NONO1,NONO); HFINAL←H; ⊃;
    OUTSTR(" H="&CVS(H)&'15&'12);
⊃;
$ Main program starts here;
CHAN←1;
HFINAL←256;
T←B←J←X←0;
WHILE TRUE DO
  ⊂ "LOOP"
    WHILE TRUE DO
    ⊂ "FORWARD"
      X←X+1;
      IF (X MOD 4)=1 THEN
      ⊂ B←B+1;T←T+1; IF T>4 THEN T←T-4; 
        IF (B MOD 4)=1 THEN
        ⊂ J←J+1; T←J; IF T>4 THEN T←T-4; IF T<1 THEN T←T+4;
      IF X≤96 THEN ⊂ OUTSTR('15&'12&
"Round "&CVS(J)&" ("&CVS(X)&"/"&CVS(J)&","&CVS(B)&","&CVS(T)&")"&'15&'12);
SUMMARY←SUMMARY&'15&'12&
"Round "&CVS(J)&" ("&CVS(X)&"/"&CVS(J)&","&CVS(B)&","&CVS(T)&")"&'15&'12; ⊃
      ELSE ⊂ EVAL; IF H≤144  THEN DONE "LOOP";  DONE "FORWARD"; ⊃; ⊃;
      ⊃;
      DOX;
      IF PSAVE[X]>16 THEN DONE "FORWARD";
    ⊃ "FORWARD";
    WHILE TRUE DO
    ⊂ "BACKWARD"
      X←X-1;
      IF X≤1 THEN DONE "LOOP";
      IF (X MOD 4)=0 THEN
      ⊂ B←B-1; T←T-1; IF T>1 THEN T←4;
        OUTSTR('15&'12&"("&CVS(B)&")");
        I←ISAVE[B]; K←KSAVE[B]; M←MSAVE[B]; N←NSAVE[B];
        IF (B MOD 4)=0 THEN ⊂ J←J-1; T←J; IF T>4 THEN T←T-4;
        IF J<6 THEN
        OUTSTR('15&'12&"("&CVS(X)&"/"&CVS(J)&","&CVS(B)&":"&CVS(T)&")"); ⊃; ⊃;
      REDOX;
      IF PSAVE[X]≤16 THEN DONE "BACKWARD";
    ⊃ "BACKWARD";
  ⊃ "LOOP";

TALLY←"\|\\M1CORON;\M2BDI40;\M3NGR40;";
P←0;
FOR I←1 STEP 1 UNTIL 16 DO
⊂ "III"
  TALLY←TALLY&"\F1	Player No. "
&CVS(I)&'11&"Name"&'15&'12&'15&'12&"\F2Round	Table		With		Score"&'15&'12;
  FOR J←1 STEP 1 UNTIL 6 DO
  ⊂ "JJJ"
    T←LDB(POINT(9,SET1[I,J],8));
    K←LDB(POINT(9,SET1[I,J],17));
    TALLY←TALLY&CVS(J)&'11&'11&CVS(T)&'11&'11&CVS(K)&'15&'12;
  ⊃ "JJJ";
  TALLY←TALLY&"\F3"&'11&'11&'11&'11&'11&"Total"&'15&'12&'15&'12&'15&'12;
  P←P+1;  IF P=3 THEN
   ⊂ P←0;  TALLY←TALLY&'14; ⊃ ELSE  TALLY←TALLY&'15&'12&'15&'12&'15&'12;
⊃ "III";
TALLY←TALLY&SUMMARY&'15&'12&'14;
CLOSE(CHAN); OPEN(CHAN,"DSK",0,0,2,0,0,0); 
ENTER(CHAN,"TALLY[ALS,ALS]",0);
OUT(CHAN,TALLY); CLOSE(CHAN);
⊃ "FOURSOME";